#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <math.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifdef __MACH__
#define setjmp(e) sigsetjmp(e, 0)
#define longjmp siglongjmp
#endif
#ifdef _WIN32
#include <windows.h>
#define X __declspec(dllexport)
#else
#define X
#endif
typedef int lval;

// o2c - lval to cons
lval *o2c(lval o) { return (lval*)(o - 1); }

// c2o - const to lval
lval c2o(lval *c) { return (lval)c + 1; }

// cp - consp
int cp(lval o) { return (o & 3) == 1; }

// o2a - lval to array
lval *o2a(lval o) { return (lval*)(o - 2); }

// a2o - array to lval
lval a2o(lval *a) { return (lval)a + 2; }
int ap(lval o) { return (o & 3) == 2; }

// o2s - binvec to lval
lval *o2s(lval o) { return (lval*)(o - 3); }

// o2z - lval to ASCIZ
char *o2z(lval o) { return (char*)(o - 3 + 2*sizeof(lval)); }
lval s2o(lval *s) { return (lval)s + 3; }
int sp(lval o) { return (o & 3) == 3; }

struct symbol_init
{
    const char *name;
    lval (*fun)();
    int argc;
    lval (*setfun)();
    int setargc;
    lval sym;
}; // symbol_init

extern struct symbol_init symi[];
#define TRUE symi[1].sym
#define T g[-2]
#define U g[-3]
#define V g[-4]
#define W g[-5]
#define NF(n) lval *g; g=f+n+3; f[1]=0; g[-1]=(n<<5)|16; *g=*f;
#define E *f
#define NE *g

lval car(lval c) { return (c & 3) == 1 ? o2c(c)[0] : 0; }
lval cdr(lval c) { return (c & 3) == 1 ? o2c(c)[1] : 0; }
lval caar(lval c) { return car(car(c)); }
lval lread(lval *);
lval cdar(lval c) { return cdr(car(c)); }
lval evca(lval *, lval);
lval cadr(lval c) { return car(cdr(c)); }
int dbgr(lval *,int,lval,lval *);
lval cddr(lval c) { return cdr(cdr(c)); }
void print(lval);
lval set_car(lval c, lval val) { return o2c(c)[0] = val; }
lval set_cdr(lval c, lval val) { return o2c(c)[1] = val; }

lval *binding(lval *f, lval sym, int type, int *macro)
{
    lval env;

  st:
    for (env = E; env; env = cdr(env))
    {
        lval e = caar(env);
        if (type ||
            cp(e) ? car(e) == sym &&
            (cdr(e) >> 4) == type : e == sym)
        {
            if (macro)
            {
                *macro = cp(e) && cdr(e) & 8;
            }
            return o2c(car(env))+1;
        }
    } // for

    if (macro) *macro = (o2a(sym)[8] >> type) & 32;

    if (type > 2)
    {
        dbgr(f, type, sym, &sym);
        goto st;
    }
    return o2a(sym)+4+type;
} // binding

lval *memory;
lval *memf;
int memory_size;
lval *stack;
lval xvalues=8;
lval dyns=0;
jmp_buf top_jmp;
lval pkg;
lval pkgs;
lval kwp=0;

// gcm - Garbage Collector
void gcm(lval v)
{
    lval *t;
    int i;
    st: t=(lval*)(v&~3);
    if (v&3 && !(t[0]&4))
    {
        t[0]|=4;
        switch (v&3)
        {
        case 1:
            gcm(t[0]-4); v=t[1];
            goto st;
        case 2:
            gcm(t[1]-4);
            if (t[0]>>8)
            {
                for (i=1; i<t[0]>>8; i++)
                {
                    gcm(t[i+1]);
                }
                v=t[i+1];
                goto st;
            }
        } // switch
    } // if
} // gcm

lval gc(lval *f)
{
    int i; lval *m; int l; int u = 0; int ml;
    printf(";garbage collecting...\n");
    while (memf)
    {
        lval *n = (lval*)memf[0];
        memset(memf,0,4*memf[1]);
        memf=(lval*)n;
    }
    gcm(xvalues);
    gcm(pkgs);
    gcm(dyns);
    for (; f > stack; f--)
    {
        if ((*f & 3) && (*f<memory || *f>memory+memory_size/4))
        {
            printf("%x\n", *f);
        }
        gcm(*f);
    } // for

    memf = 0;
    m = memory;
    i = 0;
    while (m < memory + memory_size/4)
    {
        l = ((m[1] & 4 ? m[0] >> 8 : 0) + 1) & ~1;

        if (m[0] & 4)
        {
            if (u)
            {
                m[-ml] = (lval)memf;
                m[1-ml] = ml;
                memf = m-ml;
                u = 0;
                i += ml;
            }
        }
        else
        {
           if (!u) ml = 0;
           ml += l + 2;
           u = 1;
        }

        m[0] &= ~4;
        m += l + 2;
    } // while
    if (u)
    {
        m[-ml] = (lval)memf;
        m[1-ml] = ml;
        memf = m-ml;
        i += ml;
    }
    printf(";done. %d free.\n", i);
    return 0;
} // gc

// Allocate n cells. n is adjust to even.
lval *m0(lval *g, int n)
{
    lval *m = memf;
    lval *p = 0;
    n = (n + 1) & ~1;
    for (; m; m = (lval*)m[0])
    {
        if (n <= m[1])
        {
            if (m[1]==n)
                if (p)
                    p[0] = m[0];
                else
                    memf = (lval*)m[0];
            else
            {
                m[1] -= n; m += m[1];
            }
            return m;
        }
        p = m;
    }
    return 0;
} // m0

// Allocate n n+2 cells.
lval *ma0(lval *g, int n)
{
    lval *m;
    st: m = m0(g, n+2);
    if (!m) { gc(g); goto st; }
    *m = n<<8;
    return m;
}

lval *ms0(lval *g, int n) { lval *m; st: m = m0(g, (n+12)/4);
 if (!m) { gc(g); goto st; } *m = (n+4)<<6; return m; }

lval *mb0(lval *g, int n) { lval *m; st: m = m0(g, (n+95)/32);
 if (!m) { gc(g); goto st; } *m = (n+31)<<3; return m; }

// ma - make array
X lval ma(lval *g,int n,...) { va_list v; int i; lval *m; st: va_start(v, n);
 m=m0(g,n+2); if (!m) {for (i=-1;i<n;i++) gcm(va_arg(v,lval)); gc(g); goto st;}
 *m = n<<8; for (i=-1; i < n; i++) m[2 + i] = va_arg(v, lval); return a2o(m); }

// ms - make symbol
X lval ms(lval *g,int n,...) { va_list v; int i; lval *m; st: va_start(v, n);
 m = m0(g,n+2); if (!m) { gc(g); goto st; } *m = n<<8; for (i=-1; i < n; i++)
   m[2 + i] = va_arg(v, lval); return s2o(m); }

double o2d(lval o)
{
    return sp(o) ? *(double*)(o2s(o) + 2) : o>>5;
}

// Coerce double to lispval
lval d2o(lval *g, double d)
{
    lval x = (lval)d<<5|16;
    lval *a;
    if (o2d(x) == d)
        return x;
    a = ma0(g, 2);
    a[1] = 84;
    *(double*)(a+2) = d;
    return s2o(a);
}
int o2i(lval o) { return (int)o2d(o); }
unsigned o2u(lval o) { return (unsigned)o2d(o); }
lval cons(lval *g, lval a, lval d) { lval *c = m0(g, 2); if (!c) { gcm(a);
 gcm(d); gc(g); c = m0(g, 2); } c[0] = a; c[1] = d; return c2o(c); }
int string_equal_do(lval a, lval b) { int i; for (i=0; i < o2s(a)[0]/64-4; i++)
  if (o2z(a)[i] != o2z(b)[i]) return 0; return 1; }
int string_equal(lval a, lval b) { return a == b || (sp(a) && sp(b) &&
  o2s(a)[1] == 20 && o2s(b)[1] == 20 && o2s(a)[0] == o2s(b)[0]
  && string_equal_do(a, b)); }
lval argi(lval a, lval *b) { if (cp(a)) { *b = cdr(a); return car(a); }
 *b = 0; return a; }
lval rest(lval *h, lval *g) { lval *f = h-1; lval r = 0; for (; f>=g; f--)
  r = cons(h, *f, r); return r; }
lval args(lval *, lval, int);
lval argd(lval *f, lval n, lval a) { if (cp(n)) { lval *h = f;
 for (; a; a = cdr(a)) *++h = car(a); ++h; *++h = *f; return args(f, n, h-f-2); }
 return cons(f,cons(f,n,a),*f); }

lval args(lval *f, lval m, int c)
{
lval *g = f+1; lval *h = f+c+2; int t;
 lval k,*l; st: t=0; while (cp(m)) { lval n = car(m); m = cdr(m);
 switch(cp(n) ? -1 : o2a(n)[7]>>3) { case 2: case 3: t=1; continue;
 case 4: t=2; continue; case 5: t=-2; continue; case 6: t=4; continue;
 case 7: t=5; continue; default: switch (t) { case 0: if (g>=h-1) {
   dbgr(g, 7, 0, h); goto st; } *h = argd(h, n, *g); break;
 case 1: *h = cons(h, cons(h,n,rest(h-1, g)), *h); t=-1; continue;
 case 2: n=argi(n,&k); *h=argd(h,n,g<h-1?*g:evca(h, k)); break;
 case -2: n=argi(n,&k); for (l=g; l<h-1; l+=2)
   if (string_equal(o2a(n)[2], o2a(*l)[2]) && o2a(*l)[9] == kwp) {
     k=l[1]; break; } *h=argd(h,n,l<h-1?k:evca(h,k)); continue;
 case 4: *h=cons(h,cons(h,n,rest(h-1,f+1)),*h); t=0; continue;
 case 5: *h=cons(h,cons(h,n,f[-1]),*h); t=0; continue; }} g++; } if (m)
     return cons(h,cons(h,m,rest(h-1,g)),*h); if (g<h-1 && t>=0) {
       h[-1]=(c<<5)|16; dbgr(h,6,0,h); goto st; } return *h; }

lval eval_body(lval *f, lval ex) { NF(1) T=0;
 for (; ex; ex=cdr(ex)) T = evca(g, ex); return T; }
int map_eval(lval *f, lval ex) { lval *g = f+3; for (; ex; ex=cdr(ex), g++) {
  g[-1]=((g-f-3)<<5)|16; *g = *f; g[-1] = evca(g, ex); } return g-f-3; }

lval eval(lval *f, lval expr) { NF(1) T=0; T=cons(g,expr,0); return evca(g,T);}
lval rvalues(lval *g, lval v) { return xvalues==8 ? cons(g, v, 0) : xvalues; }

lval mvalues(lval a) { xvalues = a; return car(a); }

// infn - lambda
lval infn(lval *f, lval *h)
{
    jmp_buf jmp;
    lval vs;
    lval *g=h+1;
    lval fn=*f;
    int d=h-f-1;
    h[1]=o2a(fn)[3];
    NE=args(f,o2a(fn)[4],d);
    g[-1]=cons(g,dyns,ms(g,1,20,&jmp));
    NE=cons(g,cons(g,cons(g,o2a(fn)[6],64),g[-1]),NE);
    g[-1]=(d<<5)|16;
    if (!(vs=setjmp(jmp)))
    {
        return eval_body(g,o2a(fn)[5]);
    }
    return mvalues(car(vs));
} // infn

// call
//  f   -- stack top
//  fn  -- funcallable object
//  d   -- number of arguments
X lval call(lval *f, lval fn, unsigned d)
{
    lval *g = f+d+3; xvalues = 8;
    if (o2a(fn)[1]==20)
    {
        fn=o2a(fn)[5];
    }

    if (o2a(fn)[0]&16)
    {
        fn=o2a(fn)[3];
    }

    *++f=fn;
    fn=o2a(fn)[2];

    // Too few argumetns?
    if (d<(unsigned)o2s(fn)[3])
    {
        dbgr(g,7,0,f);
    }

    // Too many arguments?
    if (d>(unsigned)o2s(fn)[4])
    {
        dbgr(g,6,0,f);
    }

    return ((lval(*)())o2s(fn)[2])(f, f+d+1);
} // call

lval eval_quote(lval *g, lval ex) { return car(ex); }

int specp(lval *f, lval ex, lval s) { for (; ex; ex = cdr(ex))
  if (ap(caar(ex)) && o2a(caar(ex))[7] == 3<<3) { lval e = cdar(ex);
  for (; e; e = cdr(e)) if (o2a(caar(e))[7] == 4<<3) { lval sp = cdar(e);
  for (; sp; sp=cdr(sp)) if (car(sp) == s) return 1; }} else break; return 0; }

void unwind(lval *f, lval c) { lval e; NF(0) for (; dyns != c; dyns=cdr(dyns))
  if (ap(car(dyns))) if (o2a(car(dyns))[1] == 52) { NE=o2a(car(dyns))[2];
  eval_body(g,o2a(car(dyns))[3]); } else for (e=o2a(car(dyns))[2]; e; e=cdr(e))
    o2a(caar(e))[4] = cdar(e); else o2s(car(dyns))[2] = 0; }

lval eval_let(lval *f, lval ex) { lval r; NF(3) T=car(ex); U=E; V=0;
 r=ma(g,1,84,0); dyns=cons(g,r,dyns); for (; T; T=cdr(T)) { V=evca(g, cdar(T));
 if (o2a(caar(T))[8] & 128 || specp(g,cdr(ex),caar(T))) {
   o2a(r)[2] = cons(g, cons(g, caar(T), V), o2a(r)[2]); }
 else U = cons(g, cons(g, caar(T), V), U); } for (r = o2a(r)[2]; r; r=cdr(r)) {
   T = o2a(caar(r))[4]; o2a(caar(r))[4] = cdar(r); set_cdr(car(r), T);
   U = cons(g, cons(g,caar(r),-8), U); } NE = U; T = eval_body(g, cdr(ex));
   unwind(g, cdr(dyns)); return T; }
lval eval_letm(lval *f, lval ex) { lval r; NF(2) T=U=0; r = ma(g, 1, 84, 0);
 dyns = cons(g, r, dyns); for (T=car(ex); T; T=cdr(T)) { U = evca(g, cdar(T));
 if (o2a(caar(T))[8] & 128 || specp(g,cdr(ex),caar(T))) {
   o2a(r)[2] = cons(g, cons(g, caar(T), o2a(caar(T))[4]), o2a(r)[2]);
   o2a(caar(T))[4] = U; U=-8; } U = cons(g, caar(T), U); NE = cons(g, U, NE); }
 T = eval_body(g, cdr(ex)); unwind(g, cdr(dyns)); return T; }

lval eval_progv(lval *f, lval ex)
{
    lval r; NF(2) T=U=0; r = ma(g,1,84,0); T=evca(g,ex);
    U=evca(g, cdr(ex)); dyns=cons(g, r, dyns);
    for (; T&&U; T=cdr(T), U=cdr(U))
    {
        o2a(r)[2] = cons(g, cons(g, car(T), o2a(car(T))[4]), o2a(r)[2]);
        o2a(car(T))[4] = car(U);
    }
    T = eval_body(g, cddr(ex));
    unwind(f, cdr(dyns));
    return T;
} // eval_progv

lval eval_flet(lval *f, lval ex) { NF(4) V=W=0; U=E; for (T=car(ex); T; T=cdr(T)) {
  V=ma(g,5,212,ms(f,3,212,infn,0,-1),E,cadr(car(T)),cddr(car(T)),caar(T)); W=cons(g,caar(T),16);
  V = cons(g, W, V); U = cons(g, V, U); } NE=U; return eval_body(g, cdr(ex)); }
lval eval_labels(lval *f, lval ex) { NF(4) V=W=0; U=E; for (T=car(ex); T; T=cdr(T))
  U = cons(g, 0, U); NE=U; for (T = car(ex); T; T = cdr(T), U = cdr(U)) {
    V=ma(g,5,212,ms(f,3,212,infn,0,-1),NE,cadr(car(T)),cddr(car(T)),caar(T)); W=cons(g,caar(T),16);
    set_car(U, cons(g, W, V)); } return eval_body(g, cdr(ex)); }
lval eval_macrolet(lval *f, lval ex) { NF(4) V=W=0; U=E; for (T=car(ex); T; T=cdr(T)){
  V=ma(g,5,212,ms(f,3,212,infn,0,-1),E,cadr(car(T)),cddr(car(T)),caar(T)); W=cons(g,caar(T),24);
  V = cons(g, W, V); U = cons(g, V, U); } NE=U; return eval_body(g, cdr(ex)); }

lval eval_symbol_macrolet(lval *f, lval ex) { NF(3) V=0; U=E;
 for (T=car(ex); T; T=cdr(T)) { V=cons(g,caar(T),8); V=cons(g,V,cadr(car(T)));
 U = cons(g, V, U); } NE=U; return eval_body(g, cdr(ex)); }

lval eval_setq(lval *f, lval ex) { lval r; do { r = evca(f, cdr(ex));
  *binding(f, car(ex), 0, 0) = r; ex = cddr(ex); } while (ex); return r; }

lval eval_function(lval *f, lval ex)
{
    lval x; ex = car(ex);
    if (cp(ex))
    {
        if(car(ex)==symi[75].sym)
        {
            lval n=0; x=cddr(ex);
            if (!cdr(x) && caar(x) == symi[23].sym)
            {
                x=car(x); n=cadr(x); x=cddr(x);
            }
            return ma(f,5,212,ms(f,3,212,infn,0,-1),E,cadr(ex),x,n);
        }
        else
        {
            x = *binding(f, cadr(ex), 2, 0);
        }
    }
    else
    {
        x = *binding(f, ex, 1, 0);
    }
    if (x != 8) return x;
    dbgr(f, 1, ex, &x);
    return x;
} // eval_function

lval eval_tagbody(lval *f, lval ex)
{
    jmp_buf jmp; lval tag; lval e; NF(2) T=U=0;
    U = ms(g, 1, 52, &jmp); dyns = cons(g, U, dyns); for (e=ex; e; e=cdr(e))
   if (ap(car(e))) { T = cons(g, dyns, U);
   NE = cons(g, cons(g, cons(g, car(e), 48), T), NE); } e = ex; again:
     if (!(tag = setjmp(jmp))) {for (;e;e=cdr(e)) if (!ap(car(e))) evca(g,e); }
     else for (e=ex; e; e=cdr(e)) if (car(e) == tag) { e=cdr(e); goto again; }
     unwind(g, cdr(dyns)); return 0;
} // eval_tagbody

lval eval_go(lval *f, lval ex)
{
    lval b = *binding(f, car(ex), 3, 0);
    if (o2s(cdr(b))[2]) { unwind(f, car(b));
    longjmp(*(jmp_buf*)(o2s(cdr(b))[2]), car(ex)); } dbgr(f, 9, car(ex), &ex);
    longjmp(top_jmp, 1);
} // eval_go

lval eval_block(lval *f, lval ex)
{
    jmp_buf jmp; lval vs; NF(2) T=U=0;
    T = ms(g, 1, 52, &jmp); U = cons(g, dyns, T); dyns = cons(g, T, dyns);
    NE = cons(g, cons(g, cons(g, car(ex), 64), U), NE);
    if (!(vs = setjmp(jmp))) {
   T = eval_body(g, cdr(ex)); unwind(g, cdr(dyns)); return T; }
 return mvalues(car(vs)); }
lval eval_return_from(lval *f, lval ex) { lval b; jmp_buf *jmp; NF(1) T=0; 
 b=*binding(g,car(ex),4,0); jmp = (jmp_buf*)o2s(cdr(b))[2]; if (jmp) {
   unwind(g, car(b)); T = rvalues(g, evca(g, cdr(ex)));
   longjmp(*jmp, cons(g, T, 0)); } dbgr(g,8,car(ex),&T); longjmp(top_jmp, 1); }

lval eval_catch(lval *f, lval ex) { jmp_buf jmp; lval vs; lval oc = dyns; NF(2)
 T=U=0; U = evca(g, ex); T = ms(g, 1, 20, &jmp); T = cons(g, U, T);
 dyns = cons(g, T, dyns); if (!(vs = setjmp(jmp))) vs = eval_body(g, cdr(ex));
 else vs = mvalues(car(vs)); dyns = oc; return vs; }
lval eval_throw(lval *f, lval ex) { lval c; NF(1) T=0; T=evca(g, ex); st:
  for (c = dyns; c; c = cdr(c)) if (cp(car(c)) && caar(c) == T) {
    unwind(g, c); T = evca(g, cdr(ex)); T = rvalues(g, T);
    longjmp(*(jmp_buf*)(o2s(cdar(c))[2]), cons(g, T, 0)); }
  dbgr(g, 5, T, &T); goto st; }
lval eval_unwind_protect(lval *f, lval ex) { NF(1) T=0; T=ma(g,2,52,E,cdr(ex));
 dyns = cons(g, T, dyns); T = evca(g, ex); T = rvalues(g, T);
 unwind(g, cdr(dyns)); return mvalues(T); }
lval eval_if(lval *f, lval ex) { return evca(f, evca(f,ex)?cdr(ex):cddr(ex)); }

lval eval_multiple_value_call(lval *f, lval ex) { lval *g=f+3; lval l;
 f[1]=evca(f, ex); for (ex=cdr(ex); ex; ex=cdr(ex)) { *g=*f;
 g[-1]=((g-f-3)<<5)|16; for (l = rvalues(g, evca(g, ex)); l; l = cdr(l)) {
   g[-1] = car(l); g++; }} xvalues = 8; return call(f, f[1], g-f-3); }
lval eval_multiple_value_prog1(lval *f, lval ex) { NF(1) T=0; T = evca(g, ex);
 T = rvalues(g, T); eval_body(g, cdr(ex)); return mvalues(T); }
lval eval_declare(lval *f, lval ex) { return 0; }
lval l2(lval *f, lval a, lval b) { return cons(f, a, cons(f, b, 0)); }

lval eval_setf(lval *f, lval ex)
{
    lval r; int m; NF(1) T=0; ag:
    if (!cp(car(ex)))
    {
        r = *binding(g, car(ex), 0, &m);
        if (!m) return *binding(g, car(ex), 0, 0) = evca(g, cdr(ex)); set_car(ex, r);
        goto ag;
    }
    r = *binding(g,caar(ex),2,0);
    if (r==8) dbgr(g, 1, l2(f, symi[33].sym, caar(ex)), &r);
    T = cons(g, cadr(ex), cdar(ex)); return call(g, r, map_eval(g, T));
} // eval_setf

lval llist(lval *f, lval *h) { return rest(h, f+1); }
lval lvalues(lval *f, lval *h) { return mvalues(rest(h, f+1)); }

lval lfuncall(lval *f, lval *h)
{
    return call(f, f[1], h-f-2);
} // lfncall

lval lapply(lval *f, lval *h)
{
    while (h[-1])
    {
        h[0] = cdr(h[-1]);
        h[-1] = car(h[-1]); h++;
    }
    return call(f, f[1], h-f-3);
} // lapply

lval leq(lval *f) { return f[1] == f[2] ? TRUE : 0; }
lval lcons(lval *f) { return cons(f, f[1], f[2]); }
lval lcar(lval *f) { return car(f[1]); }
lval setfcar(lval *f) { return set_car(f[2], f[1]); }
lval lcdr(lval *f) { return cdr(f[1]); }
lval setfcdr(lval *f) { return set_cdr(f[2], f[1]); }

lval lequ(lval *f, lval *h) { double s = o2d(f[1]); for (f += 2; f < h; f++)
  if (s != o2d(*f)) return 0; return TRUE; }

lval lless(lval *f, lval *h) { double s = o2d(f[1]); for (f += 2; f < h; f++)
  if (s < o2d(*f)) s = o2d(*f); else return 0; return TRUE; }
lval lplus(lval *f, lval *h) { double s = 0; for (f++; f < h; f++)
  s += o2d(*f); return d2o(f, s); }
lval lminus(lval *f, lval *h) { double s = o2d(f[1]); f += 2; if (f < h)
  for (; f < h; f++) s -= o2d(*f); else s = -s; return d2o(f, s); }
lval ltimes(lval *f, lval *h) { double s = 1; for (f++; f < h; f++)
  s *= o2d(*f); return d2o(f, s); }
lval ldivi(lval *f, lval *h) { double s = o2d(f[1]); f += 2; if (f < h)
  for (; f < h; f++) s /= o2d(*f); else s = 1/s; return d2o(f, s); }
lval ldpb(lval *f) { int s=o2i(car(f[2])); int p=o2i(cdr(f[2]));
 int m=(1<<s)-1; return d2o(f, (o2i(f[1])&m)<<p | (o2i(f[3]) & ~(m<<p))); }
lval lldb(lval *f) { int s = o2i(car(f[1])); int p = o2i(cdr(f[1]));
 return d2o(f, o2i(f[2])>>p & ((1<<s)-1)); }
lval lfloor(lval *f, lval *h) { double n = o2d(f[1]);
 double d = h-f>2 ? o2d(f[2]) : 1;
 double q = floor(n/d); return mvalues(l2(f, d2o(f, q), d2o(f, n-q*d))); }
int gensymc = 0;
lval lgensym(lval *f) { lval *r = ms0(f, 4); r[1] = 20; sprintf((char*)(r+2),
  "g%3.3d", gensymc++); return ma(f,9,20,s2o(r),0,8,8,8,-8,16,0,0); }
lval lcode_char(lval *f) { unsigned int c = o2u(f[1]); return c<256?32*c+24:0;}
lval lchar_code(lval *f) { return f[1]&~8; }
lval lmakef(lval *f) { return d2o(f, f-stack); }
lval lfref(lval *f) { return stack[o2i(f[1])]; }

lval stringify(lval *f, lval l)
{
    int i; lval *r; lval t = l; *++f = l;
    for (i=0; t; i++, t=cdr(t));
    r = ms0(f, i); r[1] = 20; ((char*)r)[i+8] = 0;
    for (i=8; l; i++, l=cdr(l)) ((char*)r)[i]=car(l) >> 5;
    return s2o(r);
}

lval lstring(lval *f, lval *h)
{
    return stringify(f, rest(h, f+1));
}

// Coerce lispval to integer.
lval lival(lval *f)
{
    return d2o(f, f[1]);
}

lval lmakei(lval *f, lval *h) { int i=2; int l=o2i(f[1]); lval *r = ma0(h, l);
 r[1] = f[2]|4; memset(r+2, 0, 4*o2i(f[1])); for (f += 3; f < h; f++, i++) {
   if (i >= l+2) printf("overinitializing in makei\n"); r[i] = *f; }
 return a2o(r); }

lval liboundp(lval *f)
{
    return o2a(f[1])[o2u(f[2])] == 8 ? 0 : TRUE;
}

lval limakunbound(lval *f)
{
    o2a(f[1])[o2u(f[2])] = 8;
    return 0;
}

lval liref(lval *f)
{
    if(o2u(f[2])>=o2a(f[1])[0]/256+2)
        write(1, "out of bounds in iref\n", 22);
    return ((lval*)(f[1]&~3))[o2u(f[2])] & ~4;
}

lval setfiref(lval *f)
{
    int i=o2i(f[3]);
    if(i>=o2a(f[2])[0]/256+2)
    {
        printf("out of bounds in setf iref\n");
    }
    return ((lval*)(f[2]&~3))[i]=i==1?f[1]|4:f[1];
}

lval lmakej(lval *f)
{
    lval *r = mb0(f, o2i(f[1])); r[1] = o2i(f[2]);
    memset(r+2,0,(o2i(f[1])+7)/8);
    return s2o(r);
} 

lval ljref(lval *f)
{
    return d2o(f, o2s(f[1])[o2u(f[2])]);
}

lval setfjref(lval *f) { return o2s(f[2])[o2u(f[3])] = o2u(f[1]); }

#ifdef _WIN32

lval lmake_fs(lval *f)
{
    HANDLE fd = CreateFile(
        o2z(f[1]),
        f[2] ? GENERIC_WRITE : GENERIC_READ,
        f[2] ? FILE_SHARE_WRITE : FILE_SHARE_READ,
        NULL,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
        NULL);
        return ms(f, 4, 116, 1, fd, f[2], 0);
}

lval lclose_fs(lval *f)
{
    CloseHandle(o2s(f[1])[3]);
    return 0;
}

lval llisten_fs(lval *f) {
  return WaitForSingleObject(o2s(f[1])[3], 0) == WAIT_OBJECT_0 ? TRUE : 0; }
lval lread_fs(lval *f) { int l = o2i(f[3]); if (!ReadFile(o2s(f[1])[3],
 o2z(f[2])+l, (o2s(f[2])[0]>>6)-4 - l, &l, NULL)) return 0; return d2o(f, l); }
lval lwrite_fs(lval *f) { int l=o2i(f[3]); if (!WriteFile(o2s(f[1])[3],
 o2z(f[2])+l, o2i(f[4]) - l, &l, NULL)) return 0; return d2o(f, l); }
lval lfinish_fs(lval *f) { FlushFileBuffers(o2s(f[1])[3]); return 0; }

lval lfasl(lval *f)
{
    HMODULE h;
    FARPROC s;
    h = LoadLibrary(o2z(f[1]));
    s = GetProcAddress(h, "init");
    return s(f);
}

lval luname(lval *f)
{
    OSVERSIONINFO osvi;
    osvi.dwOSVersionInfoSize=sizeof(OSVERSIONINFO); GetVersionEx(&osvi);
    f[1]=cons(f+1,strf(f+1,osvi.szCSDVersion),0);
    f[1]=cons(f+1,d2o(f+1,osvi.dwBuildNumber),f[1]);
    f[1]=cons(f+1,d2o(f+1,osvi.dwMinorVersion),f[1]);
    return cons(f+1,d2o(f,osvi.dwMajorVersion),f[1]);
}
#else
#include <sys/time.h>
#include <unistd.h>
#include <dlfcn.h>
#include <sys/utsname.h>
lval lmake_fs(lval *f) { int fd = open(o2z(f[1]), f[2] ? O_WRONLY|O_CREAT|O_TRUNC : O_RDONLY, 0600);
 return fd >= 0 ? ms(f, 4, 116, 1, fd, f[2], 0) : d2o(f, errno); }
lval lclose_fs(lval *f) { close(o2s(f[1])[3]); return 0; }
lval llisten_fs(lval *f) { fd_set r; struct timeval t; t.tv_sec=0; t.tv_usec=0;
 FD_ZERO(&r); FD_SET(o2s(f[1])[3], &r);
 return select(o2s(f[1])[3] + 1, &r, NULL, NULL, &t) ? TRUE : 0; }
lval lread_fs(lval *f) { int l = o2i(f[3]); l = read(o2s(f[1])[3], o2z(f[2])+l,
 (o2s(f[2])[0]>>6)-4 - l); return l < 0 ? cons(f, errno, 0) : d2o(f, l); }
lval lwrite_fs(lval *f) { int l = o2i(f[3]); l = write(o2s(f[1])[3],
 o2z(f[2]) + l, o2i(f[4]) - l); return l < 0 ? cons(f, errno, 0) : d2o(f, l); }
lval lfinish_fs(lval *f) { fsync(o2s(f[1])[3]); return 0; }
lval lfasl(lval *f) { void *h; lval (*s)(); h = dlopen(o2z(f[1]), RTLD_NOW);
  s = dlsym(h, "init"); return s(f); }
lval luname(lval *f) { struct utsname un; uname(&un);
 f[1]=cons(f+1,strf(f+1,un.machine),0);
 f[1]=cons(f+1,strf(f+1,un.version),f[1]);
 f[1]=cons(f+1,strf(f+1,un.release),f[1]);
 return cons(f+1,strf(f,un.sysname),f[1]); }
#endif

FILE *ins;

void load(lval *f, char *s)
{
    lval r;
    FILE *oldins = ins;
    ins = fopen(s, "r");
    if (ins)
    {
        do r = eval(f, lread(f)); while (r != 8);
        fclose(ins);
    }
    ins = oldins;
}

lval lload(lval *f) { load(f, o2z(f[1])); return symi[1].sym; }

lval lstring_equal(lval *f) { return string_equal(f[1], f[2]) ? TRUE : 0; }

lval leval(lval *f, lval *h) { f[-1] = h-f>2?f[2]:0; return eval(f-1, f[1]); }

void psym(lval p, lval n) { int i; if (!p) printf("#:"); else if (p != pkg) {
  lval m = car(o2a(p)[2]); for (i=0; i<o2s(m)[0]/64-4; i++) putchar(o2z(m)[i]);
  putchar(':'); } for (i = 0; i < o2s(n)[0]/64-4; i++) putchar(o2z(n)[i]); }

void print(lval x)
{
    int i;
    switch (x & 3)
    {
    case 0: // immediate
        if (x)
        {
            if (x&8)
            {
                if (x>>5 < 256 && isgraph(x>>5))
                {
                    printf("#\\%c", x>>5);
                }
                else
                {
                    printf("#\\U+%d", x>>5);
                }
            }
            else
            {
                printf("%d", x>>5);
            }
        else
        {
            printf("nil");
        }
        break;

    case 1: // cons
        printf("(");
        print(car(x));
        for (x=cdr(x); cp(x); x=cdr(x))
        {
            printf(" ");
            print(car(x));
        } // for
        if (x)
        {
            printf(" . ");
            print(x);
        }
        printf(")");
        break;
    case 2:
        switch (o2a(x)[1])
        {
        case 212:   // function
            printf("#<function ");
            print(o2a(x)[6]);
            printf(">");
            break;
        case 20:    // symbol
            psym(o2a(x)[9], o2a(x)[2]);
            break;
        case 116:   // vector
            printf("#(");
            for (i = 0; i < o2a(x)[0]>>8; i++)
            {
                if (i) printf(" ");
                print(o2a(x)[i+2]);
            }
            printf(")");
            break;
        case 180:
            printf("#<package ");
            print(car(o2a(x)[2]));
            printf(">");
            break;
        default:
            if (ap(o2a(x)[1]))
            {
                printf("#<");
                print(o2a(o2a(o2a(x)[1]-4)[2])[2]);
                printf(">");
            }
            else
            {
                printf("#(");
                for (i=0; i <= o2a(x)[0]>>8; i++) print(o2a(x)[i+1]);
                printf(")");
            }
        }
        break;

    case 3:
        switch(o2s(x)[1])
        {
        case 20: printf("\"");
            for (i=0; i < o2s(x)[0]/64-4; i++)
            {
                char c = o2z(x)[i];
                printf((c=='\\'||c=='\"' ? "\\%c" : "%c"), c);
            } // for
            printf("\"");
            break;
        case 84:
            printf("%g", o2d(x));
        }
    }
} // print

lval lprint(lval *f)
{
    print(f[1]);
    return f[1];
} // lprint

// ep - eval + print
int ep(lval *g, lval expr)
{
    int i;
    lval v = rvalues(g, eval(g, expr));
    if (car(v) == 8) return 0;
    if (v)
    {
        for (i = 0; v; v = cdr(v))
        {
            printf(";%d: ", i++);
            print(car(v));
            printf("\n");
        }
    }
    else
    {
        printf(";no values\n");
    }
    return 1;
} // ep

char *exmsg[] =
{
    "variable unbound",                     // 0
    "function unbound",                     // 1
    "array index out of bounds",            // 2
    "go tag not bound",                     // 3
    "block name not bound",                 // 4
    "catch tag not dynamically bound",      // 5
    "too many arguments",                   // 6
    "too few arguments",                    // 7
    "dynamic extent of block exited",       // 8
    "dynamic extent of tagbody exited"      // 9
};

// dbgr - debugger
int dbgr(lval *f, int x, lval val, lval *vp)
{
    lval ex;
    int i;
    lval *h=f;
    int l=0;
    NF(0)
    ex=o2a(symi[59].sym)[5];
    if (ex != 8)
    {
        h++;
        *++h=d2o(f, x);
        *++h = val;
        ex = call(f, ex, h-f-1);
        longjmp(top_jmp, 1);
    }
    printf(";exception: %s ", exmsg[x]);
    if (val) print(val);
    printf("\n;restarts:\n;[t]oplevel\n;[u]se <form> instead\n;[r]eturn <form> from function\n");
    while (1)
    {
        lval *j;
        printf(";%d> ", l);
        ex = lread(g);
        if (ex == 8) longjmp(top_jmp, 1);
        if (sp(ex) && o2s(ex)[1] == 84)
        {
            for (h = f, l = i = o2i(ex); i; i--)
            {
                if (!h[2]) break; h = o2a(h[2]);
            }
        }
        else if (ap(ex) && o2a(ex)[1] == 20)
        {
            switch(o2z(o2a(ex)[2])[0])
            {
            case 'B':
                printf(";backtrace:\n");
                j = f; for (i = 0; j; i++)
                {
                    printf(";%d: ", i);
                    if(j[0]>>5 == 4)
                    {
                        print(o2a(j[5])[6]);
                        printf(" ");
                        print(j[4]);
                    }
                    printf("\n");
                    if (!j[2]) break;
                    j=o2a(j[2]);
                }
                break;
            case 'R': *vp = eval(g, lread(g)); return 1;
            case 'T': longjmp(top_jmp, 1);
            case 'U':
                *vp = eval(g, lread(g)); return 0;
            }
        } else
            ep(h, ex);
    } // while
} // dbgr

lval evca(lval *f, lval co)
{
    lval ex=car(co);
    lval x=ex;
    int m;
  ag:
    xvalues=8;
    if (cp(ex))
    {
        lval fn = 8;
        if (ap(car(ex)) && o2a(car(ex))[1] == 20)
        {
            int i=o2a(car(ex))[7]>>3;

            // Is special-operator?
            if (i>11 && i<34)
            {
                return symi[i].fun(f, cdr(ex));
            }

            fn = *binding(f, car(ex), 1, &m);
            if (m)
            {
                lval *g = f+1;
                for (ex=cdr(ex); ex; ex=cdr(ex))
                {
                    *++g = car(ex);
                }
                x=ex=call(f, fn, g-f-1);
                set_car(co, ex);
                goto ag;
            }
        }
      st:
        if (fn==8)
        {
            if (dbgr(f,1,car(ex),&fn))
            {
                return fn;
            }
            else
            {
                goto st;
            }
        }
        ex = cdr(ex);
        ex = call(f, fn, map_eval(f, ex));
    }
    else if (ap(ex) && o2a(ex)[1] == 20)
    {
        ex = *binding(f, ex, 0, &m);
        if (m)
        {
            x = ex; set_car(co, ex); goto ag;
        }

        if (ex == 8)
        {
            dbgr(f, 0, x, &ex);
        }
        return ex == -8 ? o2a(x)[4] : ex;
    }

// getnws - get non-whitespace character
int getnws()
{
    int c;
    do
    {
        c = getc(ins);
    } while (isspace(c));
    return c;
} // getnws


// read_list
lval read_list(lval *f)
{
    int c; NF(1) T=0; c=getnws();
    if (c == ')') return 0;
    if (c == '.')
    {
        lval r = lread(g);
        getnws();
        return r;
    }
    ungetc(c, ins);
    T = lread(g);
    return cons(g, T, read_list(g));
} // read_list

lval read_string_list(lval *g)
{
    int c = getc(ins);
    if (c == '\"') return 0;
    if (c == '\\') c = getc(ins);
    return cons(g, (c << 5) | 24, read_string_list(g));
} // read_string_list

unsigned hash(lval s)
{
    unsigned char *z = o2z(s);
    unsigned i=0, h=0, g;
    while(i<o2s(s)[0]/64-4)
    {
        h=(h<<4)+z[i++];g=h&0xf0000000;
        if(g) h=h^(g>>24)^g;
    }
    return h;
}  // hash

lval lhash(lval *f)
{
    return d2o(f, hash(f[1]));
}

// is - intern symbol
lval is(lval *g, lval p, lval s)
{
    int h=hash(s)%1021;
    int i=3;
    lval m;
    for (; i<5; i++)
    {
        m=o2a(o2a(p)[i])[2+h];
        for (; m; m=cdr(m))
        {
            lval y=car(m);
            if (string_equal(o2a(y)[2], s)) return o2a(y)[7] ? y : 0;
        } // for
    } // for
    m=ma(g, 9, 20, s, 0, 8,8,8,-8,16, p, 0);
    if (p==kwp) o2a(m)[4]=m;
    o2a(o2a(p)[3])[2+h]=cons(g,m,o2a(o2a(p)[3])[2+h]);
    return m;
} // is

// read_symbol
lval read_symbol(lval *g)
{
    int c=getc(ins);
    if (isspace(c)||c==')'||c==EOF)
    {
        if (c!=EOF) ungetc(c, ins); return 0;
    }
    if (c>96 && c<123) c-= 32;
    return cons(g, (c << 5) | 24, read_symbol(g));
}

lval list2(lval *g, int a)
{
    return l2(g, symi[a].sym, lread(g));
}


//////////////////////////////////////////////////////////////////////
//
// Lisp Reader
//
lval lread(lval *g)
{
    int c = getnws();
    if (c == EOF) return 8;
    if (c == '(') return read_list(g);
    if (c == '\"') return stringify(g, read_string_list(g));
    if (c == '\'') return list2(g, 12);
    if (c == '#')
    {
        c=getnws();
        if (c == '\'') return list2(g, 20);
        return 0;
    }
    if (c=='`') return list2(g,38);
    if (c==',') {
        c = getnws();
        if (c == '@') return list2(g,40);
        ungetc(c,ins);
        return list2(g,39);
    }
    ungetc(c,ins);
    if (isdigit(c))
    {
        double d;
        fscanf(ins, "%lf", &d);
        return d2o(g, d);
    }
    if (c==':') getnws();
    return is(g, c==':' ? kwp : pkg, stringify(g, read_symbol(g)));
} // lread

lval strf(lval *f, const char *s) { int j = strlen(s); lval *str = ms0(f, j);
 str[1] = 20; for (j++; j; j--) ((char*)str)[7+j] = s[j-1]; return s2o(str); }
lval mkv(lval *f) { int i=2; lval *r=ma0(f, 1021); r[1]=116; while(i<1023)
  r[i++]=0; return a2o(r); }
lval mkp(lval *f, const char *s0, const char *s1) { return ma(f, 6, 180,
 l2(f, strf(f, s0), strf(f, s1)), mkv(f), mkv(f), 0, 0, 0); }
lval fr(lval *o, lval *p, lval *s, lval *c, lval *b, lval x) { int t;
 if (!(x&3)) return x; t=(x>>30)&3; x&=0x3fffffff; switch (t) {
 case 0: return sp(x) ? (lval)o+x : (lval)b+x; case 1: return c[x/4];
 case 2: return s[x/4]; default: return p[x/4]; }}
X lval fasr(lval *f, lval *p, int pz, lval *s, lval *sp, int sz, lval *c,
  int cz, lval *v, int vz, lval *o, int oz, lval **rv, lval **ro) {
  lval *x, *y; int i, l, j; lval pc, nc;
  y = ma0(f, oz-2); memcpy(y, o, 4*oz); for (i=0; i<pz; i++)
    for (pc=o2a(symi[81].sym)[4]; pc; pc=cdr(pc))
      for (nc=o2a(car(pc))[2]; nc; nc=cdr(nc))
	if (string_equal(car(nc), s2o(y+p[i]))) { p[i] = car(pc); break; }
  for (i=0; i<sz; i++) s[i]=is(f, p[sp[i]], s2o(y+s[i])); for (i=0; i<cz; i++)
    c[i] = o2a(s[c[i]])[3]; x = ma0(f, vz-2); memcpy(x, v, 4*vz);
    for (i=0; i<vz; i+=((l+3)&~1)) if (x[i+1]&4) { l=x[i]>>8;
    x[i+1]=fr(y,p,s,c,x,x[i+1]-4)+4; for (j=0; j<l; j++)
      x[i+j+2]=fr(y,p,s,c,x,x[i+j+2]); } else { l=0; x[i]=fr(y,p,s,c,x,x[i]);
      x[i+1]=fr(y,p,s,c,x,x[i+1]); } *rv = x; *ro = y; }
#ifdef _WIN32

// lrp - Run program
lval lrp(lval *f, lval *h)
{
    STARTUPINFO si={0};
    PROCESS_INFORMATION pi={0};
    si.cb=sizeof(si);
    if (CreateProcess(
            o2z(f[1]), o2z(f[2]), NULL, NULL, FALSE,
            0, NULL, NULL, &si, &pi) )
    {
        return TRUE;
    }
    return 0;
} // lrp
#else
lval lrp(lval *f, lval *h)
{
    pid_t p;
    int r;
    p=fork();
    if (p)
    {
        waitpid(p,&r,0);
    }
    else
    {
        int i=0;
        char **v=malloc((h-f-1)*sizeof(char*));
        for (; i<h-f-2; i++)
        {
            v[i]=o2z(f[i+2]);
        }
        v[i]=0;
        execv(o2z(f[1]), v);
    }
    return d2o(f, r);
} // lrp
#endif


//////////////////////////////////////////////////////////////////////
//
// main
//
int main(int argc, char *argv[])
{
    lval *g;
    int i;
    lval sym;

    memory_size = 4*2048*1024;  // =8MB
    memory = malloc(memory_size);
    memf = memory;
    memset(memory, 0, memory_size);
    memf[0] = 0;
    memf[1] = memory_size / 4;

    stack = malloc(256*1024);   // =256KB
    memset(stack, 0, 256*1024);

    g=stack+5;

    pkg = mkp(g, "CL", "COMMON-LISP");

    for (i=0; i < 88; i++)
    {
        sym = is(g, pkg, strf(g, symi[i].name));

        // Is symbolic constant?
        if (i < 10)
        {
            o2a(sym)[4] = sym;
        }

        ins = stdin;
        symi[i].sym = sym;
        if (symi[i].fun)
        {
            o2a(sym)[5] = ma(g, 5, 212, ms(g,3,212,symi[i].fun,0,-1), 0, 0, 0, sym);
        }

        if (symi[i].setfun)
        {
            o2a(sym)[6] = ma(g, 5, 212, ms(g,3,212,symi[i].setfun,0,-1), 8, 0, 0, sym);
        }

        o2a(sym)[7]=i<<3;
    } // for i

    kwp = mkp(g, "", "KEYWORD");
    o2a(symi[81].sym)[4] = pkgs = l2(g, kwp, pkg);

#ifdef _WIN32
  o2a(symi[78].sym)[4] = ms(g,3,116,1,GetStdHandle(STD_INPUT_HANDLE),0,0);
  o2a(symi[79].sym)[4] = ms(g,3,116,1,GetStdHandle(STD_OUTPUT_HANDLE),TRUE,0);
  o2a(symi[80].sym)[4] = ms(g,3,116,1,GetStdHandle(STD_ERROR_HANDLE),TRUE,0);
#else
  o2a(symi[78].sym)[4] = ms(g, 3, 116, 1, 0, 0, 0);
  o2a(symi[79].sym)[4] = ms(g, 3, 116, 1, 1, TRUE, 0);
  o2a(symi[80].sym)[4] = ms(g, 3, 116, 1, 2, TRUE, 0);
#endif

    for (i=1; i<argc; i++) load(g, argv[i]);
    setjmp(top_jmp);
    do
    {
        printf("? ");
    } while (ep(g, lread(g)));
    return 0;
} // main

struct symbol_init symi[] =
{
    {"NIL"},            // 0
    {"T"},              // 1
    {"&REST"},          // 2
    {"&BODY"},          // 3
    {"&OPTIONAL"},      // 4
    {"&KEY"},           // 5
    {"&WHOLE"},         // 6
    {"&ENVIRONMENT"},   // 7
    {"&AUX"},               // 8
    {"&ALLOW-OTHER-KEYS"},  // 9
    {"DECLARE", eval_declare, -1},  // 10
    {"SPECIAL"},                    // 11
    {"QUOTE", eval_quote, 1},       // 12
    {"LET", eval_let, -2},          // 13
    {"LET*", eval_letm, -2},        // 14
    {"FLET",eval_flet,-2},                          // 15
    {"LABELS",eval_labels,-2},                      // 16
    {"MACROLET",eval_macrolet,-2},                  // 17
    {"SYMBOL-MACROLET", eval_symbol_macrolet, -2},  // 18
    {"SETQ", eval_setq, 2},                         // 19
    {"FUNCTION",eval_function,1},                   // 20
    {"TAGBODY",eval_tagbody,-1},                    // 21
    {"GO",eval_go,1},                               // 22
    {"BLOCK", eval_block, -2},                      // 23
    {"RETURN-FROM", eval_return_from, 2},           // 24
    {"CATCH", eval_catch, -2},                      // 25
    {"THROW", eval_throw, -2},                      // 26
    {"UNWIND-PROTECT", eval_unwind_protect, -2},    // 27
    {"IF", eval_if, -3},                            // 28
    {"MULTIPLE-VALUE-CALL", eval_multiple_value_call, -2},  // 29
    {"MULTIPLE-VALUE-PROG1",eval_multiple_value_prog1,-2},  // 30
    {"PROGN",eval_body,-1},                                 // 31
    {"PROGV", eval_progv, -3},                              // 32
    {"_SETF", eval_setf, 2},                                // 33

    {"FINISH-FILE-STREAM", lfinish_fs, 1},                  // 34
    {"MAKEI",lmakei,-3},
    {"DPB", ldpb, 3},
    {"LDB", lldb, 2},
    {"BACKQUOTE"},
    {"UNQUOTE"},
    {"UNQUOTE-SPLICING"},
    {"IBOUNDP",liboundp,2},
    {"LISTEN-FILE-STREAM",llisten_fs, 1},
    {"LIST",llist,-1},
    {"VALUES", lvalues, -1},
    {"FUNCALL",lfuncall,-2},
    {"APPLY",lapply,-2},
    {"EQ",leq,2},
    {"CONS",lcons,2},
    {"CAR", lcar, 1, setfcar, 2},
    {"CDR", lcdr, 1, setfcdr, 2},
    {"=", lequ, -2},
    {"<", lless, -2},
    {"+", lplus, -1},
    {"-", lminus, -2},
    {"*", ltimes, -1},
    {"/", ldivi, -2},
    {"MAKE-FILE-STREAM", lmake_fs, 2},
    {"HASH", lhash, 1},
    {"IERROR"},
    {"GENSYM",lgensym,0},
    {"STRING",lstring,-1},
    {"FASL", lfasl, 1},
    {"MAKEJ", lmakej, 2},
    {"MAKEF", lmakef, 0},
    {"FREF",lfref, 1},
    {"PRINT", lprint, 1},
    {"GC", gc, 0},
    {"CLOSE-FILE-STREAM", lclose_fs, 1},
    {"IVAL", lival, 1},
    {"FLOOR", lfloor, -2},
    {"READ-FILE-STREAM", lread_fs, 3},
    {"WRITE-FILE-STREAM", lwrite_fs, 4},
    {"LOAD", lload, 1},
    {"IREF", liref, 2, setfiref, 3},
    {"LAMBDA"},                             // 75
    {"CODE-CHAR", lcode_char, 1},           // 76
    {"CHAR-CODE", lchar_code, 1},           // 77
    {"*STANDARD-INPUT*"},                   // 78
    {"*STANDARD-OUTPUT*"},                  // 79
    {"*ERROR-OUTPUT*"},                     // 80
    {"*PACKAGES*"},                         // 81
    {"STRING=",lstring_equal,2},            // 82
    {"IMAKUNBOUND",limakunbound,2},         // 83
    {"EVAL",leval,-2},                      // 84
    {"JREF",ljref,2,setfjref,3},            // 85
    {"RUN-PROGRAM", lrp, -2},               // 86
    {"UNAME",luname,0}                      // 87
}; // symi
